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-- AlFont.mesa Edited by: May 12. 1978 8:43 AM 

DIRECTORY 

BitBUDefs: FROM "bitbltdefs" USING [BBptr, BBTable, BITBLT], 
FontDefs: FROM "fontdefs" USING [BitmapState , FontHandle, FontObject], 
InlineDefs: FROM "inlinedefs" USING [BITAND, BITOR. BITSHIFT], 
SegmentDefs: FROM "segmentdef s" USING [ 

FileSegmentAddress, FileSegmentHandle, SwapIn, SwapOut, Unlock], 
SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, FreeHeapNode] ; 

DEFINITIONS FROM FontDefs; 

AlFont: PROGRAM IMPORTS SegmentDefs, SystemDefs EXPORTS FontDefs - 
BEGIN 

FileSegmentHandle: TYPE « SegmentDefs. FileSegmentHandle; 

CR: CHARACTER » 15C; 
SP: CHARACTER - ' ; 

AlFontObject: TYPE = RECORD [ 
procs: FontObject, 
seg: FileSegmentHandle, 
lockCount: CARDINAL, 
height: CARDINAL]; 

AlFontHandle: TYPE = POINTER TO AlFontObject; 

FHptr: TYPE = POINTER TO FontHeader; 
Fptr: TYPE = POINTER TO Font; 
FCDptr: TYPE = POINTER TO FCD; 
FAptr: TYPE = POINTER TO FontArray; 
FontArray: TYPE = ARRAY [0..255] OF FCDptr; 

Font: TYPE = MACHINE DEPENDENT RECORD [ 
header: FontHeader, 
FCDptrs: FontArray, -~ array of self-relative pointers to 

-- FCD's. Indexed by char value. 

-- font pointer points hearl 
extFCDptrs: FontArray -- array of self-relative pointers to 

-- FCD's for extentions. As large an 

-- array as needed. 

]; 

FontHeader: TYPE = MACHINE DEPENDENT RECORD 

[ 

maxHeight: CARDINAL, -- height of tallest char in font (scan lines) 

variableWidth: BOOLEAN, -- IF TRUE, proportionally spaced font 

blank: [0..177B]. -- not used 

maxWidth: [0..377B] -- width of widest char in font (raster units). 

]; 

FCD: TYPE = MACHINE DEPENDENT RECORD [ 

widthORext: [0..77777B], -- width or extention index 
hasNoExtension: BOOLEAN, -- TRUE=> no ext . ;prevf iel d«width 
height: [0..377B], -- # scan lines to skip for char 

displacement: [0..377B] -- displacement back to char bitmap 
]: 

CharWidth: PUBLIC PROCEDURE [font: FontHandle. char: CHARACTER] RETURNS [w: CARDINAL] 
BEGIN 

code: CARDINAL; 
cw: FCDptr; 
fontdesc: FAptr; 
-- checkfor control characters 
IF char = CR THEN char ^ SP; 
IF char < SP THEN 

RETURN[CharWidth[font, 't] + 
CharWidth[font, 

L0OPH0LE[LOOPHOLE[ char, CARDINAL]+100B. CHARACTER]]]; 
w ^ 0; 

fontdesc ^ @LockFont[font]. FCDptrs; 
code ^ LOOPHOLE[char]; 
DO 

cw <- LOOPHOLE[f on tdesc[code]+LOOPHOLE[f on tdesc, CARDINAL] t-code]; 
IF cw, hasNoExtension THEN EXIT; 
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w <r w+16; 

code <- cw.widthORext; 

ENDLOOP; 
w ^ w+cw.widthORext ; 
Un1ockFont[font] ; 
RETURN 
END; 

CharHeight: PUBLIC PROCEDURE [font: FontHandle, char: CHARACTER] RETURNS [CARDINAL] 
BEGIN 

RETURN[LOOPHOLE[f on t.Al FontHandle]. height] 
END; 

PaintChar: PROCEDURE 

[font: FontHandle, char: CHARACTER, bmState: POINTER TO BitmapState] = 
BEGIN OPEN BitBUDefs, bmState; 
bba: ARRAY [0. . SIZE[BBTab1e]] OF UNSPECIFIED; 

bbt: BBptr = LOOPHOLE[BASE[bba] + LOOPHOLE[BASE[bba] .CARDINAL] MOD 2]; 
cw: FCDptr; 

fontdesc: FAptr = @LockFont[font] . FCDptrs ; 
code: CARDINAL ^ LOOPHOLE[char] ; 
bbtt 4- [ 
pad: 0, 

sourcealt: FALSE, 

destalt: FALSE, sourcetype: block, 
function: paint, 
unused: , 
dbca: origin, 
dbmr: wordsPerLine, 
dlx: X, 
dty:, 
dw: 16. 
dh:. 
sbca: , 
sbmr: 1, 
six: 0, 
sty: 0, 

grayO:, grayl:, grayZ:, gray3:]; 
DO 

cw ^ LOOPHOLE[fontdesc[code]+LOOPHOLE[fontdesc,CARDINAL]+code]; 
bbt. dty <- y + cw. height; 
bbt.dh *- cw. displacement; 
bbt. sbca *- cw - (bbt.dh <- cw. displacement) ; 
IF cw.hasNoExtension THEN 
BEGIN 

x ♦- X + (bbt.dw <r cw.widthORext); 
BITBLT[bbt]; 
EXIT 
END 
ELSE 
BEGIN 

BITBLT[bbt]; 
bbt. dlx ^ X <- X + 16; 
END; 
code <- cw.widthORext; 
ENDLOOP; 
UnlockFont[font]; 
RETURN 
END; 

ClearChar: PROCEDURE 

[font: FontHandle. char: CHARACTER, bmState: POINTER TO BitmapState] « 

BEGIN OPEN bmState, InlineDefs; 

bit: [0..15]; 

xword: CARDINAL; 

scanLines: CARDINAL * LOOPHOLE[font.Al FontHandle] . height; 

start, p: POINTER; 

cwidth: INTEGER ^ CharWidth[font , char] ; 

mask: WORD; 

ones: WORD = 177777B; 

IF X < cwidth THEN BEGIN cwidth <- x; x <- END 

ELSE X <- X - cwidth; 

xword *- x/16; bit <~ x MOO 16; 

mask ^ BIT0R[BITSHIFT[ones.l6--bit],BITSHIFT[ones,-(bit+cwidth)]]; 

start <- origin + xword + y*wordsPerLine-l ; 

cwidth «- cwidth + bit; 
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DO 

p <- start ♦- start + 1; 
THROUGH [0..scanLines) DO 
pt ^ BITAND[pt,niask]; 
p ^ p + wordsPerLine; 
ENDLOOP: 
IF (cwidth <r cwidth - 16) <» THEN EXIT; 
mask <" BITSHIFT[ones, -cwidth]; 
ENDLOOP; 
RETURN 
END; 

LockFont: PROCEDURE [font: FontHandle] RETURNS [Fptr] » 
BEGIN OPEN SegmentDefs. af: LOOPHOLE[font , AT FontHandle] ; 
IF (af .lockCount ^ af.lockCount + 1) « 1 THEN Swapln[af .seg]; 
RETURN[FileSegmentAddress[af .seg]] 
END; 

UmockFont: PROCEDURE [font: FontHandle] « 

BEGIN OPEN SegmentDefs, af: LOOPHOLE[ront , AT FontHandle] ; 

IF (af.lockCount ^ af.lockCount - 1) = THEN Unlock[af .seg] ; 

RETURN 

END; 

DestroyFont: PROCEDURE [font: FontHandle] = 
BEGIN 

CloseFont[font]; 
SystemDef s . F reeHe ap Nod e[ font]; 
RETURN 
END; 

CloseFont: PROCEDURE [font: FontHandle] » 
BEGIN OPEN af: LOOPHOLE[font.Al FontHandle] ; 
IF af. seg. lock « THEN SegmentDefs. SwapOut[af. seg]; 
RETURN 
END; 

CreateFont: PUBLIC PROCEDURE 

[fontSegment: FileSegmentHandle] RETURNS [f: FontHandle] « 
BEGIN 

p: AlFontHandle = SystemDef s .Al locateHeapNode[SIZE[Al FontObject]]; 
f *- LOOPHOLE[p]; 
pt 4- [ 
procs: [ 

paintChar: PaintChar, 
clearChar: ClearChar, 
charWidth: CharWidth. 
charHeight: CharHeight. 
close: CloseFont, 
destroy: DestroyFont, 
lock: LockFont, 
unlock: UnlockFont], 
seg: fontSegment, 
lockCount: 0, 

height: LockFont[f] .header .maxHeight] ; 
UnlockFont[f]; 
RETURN 
END; 

END. 



